home *** CD-ROM | disk | FTP | other *** search
/ Die Speccy' 97 / Die Speccy' 97.iso / amiga_system / the_aminet / comm / bbs / bbbbs85.lha / rexx / bbsMail.rexx < prev    next >
OS/2 REXX Batch file  |  1995-02-19  |  23KB  |  906 lines
  1. /* $VER: bbsMail.rexx 8.5 (18.2.95)
  2.  * Copyright ⌐ 1994-95 Richard Lee Stockton
  3.  * BBBBS mail reader/sender with optional file attach
  4.  * FREELY DISTRIBUTABLE
  5.  * Thanks to Matt English for "SendFile.rexx"
  6.  * Thanks to John Ruckart for additional "detail work".
  7. */
  8.  
  9. IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
  10. IF ~SHOW('P','QuickSortPort') THEN EXIT 666
  11.  
  12. CALL TIME('R')
  13. title.=''
  14. title.1='bbsMail for BBBBS'
  15. title.2='Version 8.5'
  16. title.3='18-Feb-95'
  17.  
  18. OPTIONS RESULTS
  19. SIGNAL ON BREAK_C
  20. SIGNAL ON BREAK_E
  21. SIGNAL ON FAILURE
  22. SIGNAL ON SYNTAX
  23.  
  24. ARG maxtime name pw 
  25. IF ~DATATYPE(maxtime,'N') THEN maxtime=6000
  26.  
  27. def=''
  28. pen3=''
  29. bak2=''
  30. lineup='1B'x'M'
  31. CR=''
  32. frombb=0
  33. IF ADDRESS()='BAUD' THEN
  34.   DO
  35.     CR='0D'x
  36.     frombb=1
  37.   END
  38.  
  39. changed=0
  40. emailonline=0
  41. namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
  42. topath='RAM:'
  43. CALL config()
  44. IF name='' THEN
  45.   DO
  46.     OPTIONS PROMPT ' Are you 'sysop'? (Yn) > '
  47.     PULL answer
  48.     IF answer='N' THEN
  49.       DO
  50.         SAY CR
  51.         OPTIONS PROMPT ' Please enter your name > '
  52.        PULL name
  53.         name=cleanstring(name)
  54.         IF name='' THEN EXIT 1 
  55.         IF ~EXISTS(bbspath'Users/'name) THEN
  56.           DO
  57.             SAY name 'does not exist!'CR
  58.             EXIT 1
  59.           END
  60.       END
  61.     ELSE name=sysop
  62.   END
  63. userfile=bbspath'Users/'name
  64. CALL OPEN(f,userfile,'R')
  65. data.=''
  66. DO i=1
  67.   line=READLN(f)
  68.   IF EOF(f) THEN LEAVE i
  69.   data.i=line
  70. END
  71. CALL CLOSE(f)
  72. data.0=i-1
  73. password=data.5
  74. linesperpage=data.7
  75. IF ~frombb THEN linesperpage=20
  76. colorflag=1
  77. IF frombb & FIND(data.8,'COLOR')=0 THEN
  78.   DO
  79.     def=''
  80.     pen3=''
  81.     bak2=''
  82.     colorflag=0
  83.   END
  84. clr=''
  85. IF frombb & FIND(data.8,'CLEAR')>0 THEN clr='0C'x
  86. level=data.20
  87.  
  88. IF pw~=password THEN
  89.   DO
  90.     passprompt=pen3' Please Enter Password: '
  91.     DO tries=1 TO 3
  92.       OPTIONS PROMPT passprompt
  93.       PULL newpassword
  94.       SAY def
  95.       IF(password=newpassword) THEN LEAVE tries; /* correct password */
  96.       IF tries=3 THEN
  97.         DO
  98.           SAY
  99.           SAY 'Access terminated.'
  100.           SAY '*** Bad password ***' newpassword '***'
  101.           EXIT 1
  102.         END
  103.       passprompt='Incorrect.  Password: ' /* ask again */
  104.     END
  105.     SAY
  106.     SAY' OK, 'name' here we go....'
  107.     SAY
  108.   END
  109. Friends.=''
  110. IF OPEN(f,bbspath'Friends/'name,'R')~=0 THEN
  111.   DO
  112.     DO i=1
  113.       Friends.i=READLN(f)
  114.       IF EOF(f) THEN LEAVE i
  115.     END
  116.     Friends.0=i
  117.     CALL CLOSE(f)
  118.   END
  119. IF level>sysoplevel & ~frombb THEN
  120.   DO
  121.     CALL showtext(bbspath'Lists/NEW_USERS')
  122.     CALL showtext(bbspath'Lists/CBV_USERS')
  123.   END
  124. exitarg=0
  125. lm='Loading Module...'lineup||CR
  126. folk.=''
  127. replysubj=''
  128. IF ARG()=0 THEN
  129.   DO
  130.     SAY
  131.     DO i=1 TO 3
  132.       SAY CENTER(title.i,74)
  133.     END
  134.     SAY
  135.   END
  136. CALL readmail()
  137.  
  138. DONE:
  139. IF emailonline~=0 THEN
  140.   DO
  141.     x=GETCLIP('BBS_email')
  142.     IF ~DATATYPE(x,'N') THEN x=0
  143.     IF SHOW('P','BBBBS') THEN CALL SETCLIP('BBS_email',x+emailonline)
  144.     IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('LOCAL_email',x+emailonline)
  145.   END
  146. EXIT exitarg
  147.  
  148.  
  149. readmail:
  150. arg=''
  151. x=GETCLIP('BBSMAIL_ARG')
  152. IF x~='' THEN
  153.   DO
  154.     CALL SETCLIP('BBSMAIL_ARG')
  155.     fromenu=WORD(x,1)
  156.     IF WORDS(x)>1 THEN arg=SUBSTR(x,WORDINDEX(x,2))
  157.   END
  158. IF fromenu~=0 THEN fromenu=1
  159. replysubj=''
  160. IF fromenu THEN
  161.   DO
  162.     CALL postuser('Menu')
  163.     temp=UPPER(arg)
  164.     arg=''
  165.     IF temp~='F' & temp~='T' & temp~='W' THEN
  166.       DO
  167.         SAY '                  'lineup||CR
  168.         line='Find Email ['pen3'F'def']rom You ['pen3'T'def']o You or ['pen3'W'def']rite New Email or ['pen3'Q'def']uit (fqTw) > 'def
  169.         temp=getinput(1 1 line)
  170.         CALL cleanline(0)
  171.         IF temp='' THEN temp='T'
  172.       END
  173.     IF temp='W' THEN
  174.       DO
  175.         CALL postuser('Write')
  176.         SAY lm
  177.         CALL bbsWrite.rexx(name maxtime-TRUNC(TIME('E')) 'MAIL' . . 0 0)
  178.         RETURN
  179.       END
  180.     ELSE IF temp='F' THEN
  181.       DO
  182.         CALL postuser('From')
  183.         firsteditline=0
  184.         picklist.=''
  185.         picklist.0=0
  186.         IF getinput(1 1 'Check ALL users? (nY) > ')='N' THEN
  187.           DO
  188.             picklist.1=getinput(1 0 'Check EMail From' name 'To Who? > ')
  189.             picklist.1=SPACE(STRIP(UPPER(picklist.1)),1,'_')
  190.             picklist.1=COMPRESS(picklist.1,'.,:/*#?^ ')
  191.             IF picklist.1='' THEN RETURN
  192.             IF ~EXISTS(bbspath'Users/'picklist.1) THEN
  193.               DO
  194.                 SAY '***'pen3 picklist.1 def'does not exist!'||CR
  195.                 picklist.0=0
  196.                 RETURN
  197.               END
  198.             fmaillist=SHOWDIR(bbspath'EMail/'picklist.1)
  199.             DO ej=1 TO WORDS(fmaillist)
  200.               ejname=WORD(fmaillist,ej)
  201.               uname=ejname
  202.               dot=LASTPOS('.',uname)
  203.               IF dot>2 THEN uname=LEFT(uname,dot-1)
  204.               IF uname=name THEN
  205.                 DO
  206.                   arg=bbspath'EMail/'picklist.1'/'ejname
  207.                   IF EXISTS(arg) THEN
  208.                     DO
  209.                       pklst=picklist.0+1
  210.                       picklist.pklst=picklist.1
  211.                       picklist.pklst.0=ejname
  212.                       picklist.0=pklst
  213.                     END
  214.                 END
  215.             END
  216.           END
  217.         ELSE
  218.           DO
  219.             SAY 'Loading userlist...'lineup||CR
  220.             userlist=SHOWDIR(bbspath'Users')
  221.             users=WORDS(userlist)
  222.             SAY pen3'Scanning'def users pen3'email directories...'def||CR
  223.             SAY pen3' - To ABORT, press CTRL-E -'def||CR
  224.             DO wi=1 TO users
  225.               CALL busywait(60 wi users)
  226.               fmaillist=SHOWDIR(bbspath'EMail/'WORD(userlist,wi))
  227.               DO ej=1 TO WORDS(fmaillist)
  228.                 ejname=WORD(fmaillist,ej)
  229.                 uname=ejname
  230.                 dot=LASTPOS('.',uname)
  231.                 IF dot>2 THEN uname=LEFT(uname,dot-1)
  232.                 IF uname=name THEN
  233.                   DO
  234.                     arg=bbspath'EMail/'WORD(userlist,wi)'/'ejname
  235.                     IF EXISTS(arg) THEN
  236.                       DO
  237.                         pklst=picklist.0+1
  238.                         picklist.pklst=WORD(userlist,wi)
  239.                         picklist.pklst.0=ejname
  240.                         picklist.0=pklst
  241.                       END
  242.                   END
  243.               END
  244.               IF wi=999999 THEN RETURN
  245.             END
  246.           END
  247.         CALL busywait(4 0)
  248.         IF picklist.0=0 THEN SAY lineup'No Email FROM you was found.                  'CR
  249.         ELSE
  250.           DO
  251.             SAY pen3'You have the following Email pending:'def||CR
  252.             pickcheck=1
  253.             DO WHILE pickcheck~=0
  254.               pickcheck=pickfromlist()
  255.               IF pickcheck~=0 THEN
  256.                 DO
  257.                   firsteditline=5
  258.                   IF level>sysoplevel THEN firsteditline=1
  259.                   CALL bbsEd.rexx(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0 name TRUNC(maxtime-TIME('E'))-28)
  260.                   IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN
  261.                     picklist.pickcheck='- KILLED -'
  262.                 END
  263.             END
  264.           END
  265.         RETURN
  266.       END
  267.     ELSE IF temp='T' THEN BREAK
  268.     ELSE RETURN
  269.   END
  270. ELSE IF GETCLIP('BBS_'name)~='' THEN RETURN
  271. sl=1
  272. menuflag=1
  273. CALL MAKEDIR(bbspath'EMail/'name)
  274. mailist=sortnumbers(SHOWDIR(bbspath'Email/'name))
  275. IF frombb THEN
  276.   DO
  277.     sl=GETCLIP('BBSMAIL_letter')
  278.     CALL SETCLIP('BBSMAIL_letter')
  279.     IF sl~='' THEN
  280.       DO
  281.         DO i=1 TO WORDS(mailist)
  282.           IF UPPER(WORD(mailist,i))~=UPPER(sl) THEN ITERATE i
  283.           sl=i
  284.           LEAVE i
  285.         END
  286.       END
  287.     IF ~DATATYPE(sl,'W') THEN sl=1
  288.     ELSE menuflag=0
  289.   END
  290. IF menuflag THEN SAY 'Checking your mailbox...'CR
  291. CALL postuser('Reading')
  292. nomail=1
  293. IF WORDS(mailist)=0 THEN
  294.   DO
  295.     SAY lineup'Your mailbox is empty.  'CR
  296.     SAY CR
  297.     RETURN
  298.   END
  299. IF menuflag THEN
  300.   DO
  301.     line=WORDS(mailist)
  302.     IF line>1 THEN line=line 'letters'
  303.     ELSE line=line 'letter'
  304.     line=line 'waiting.'
  305.     SAY line||CR
  306.     DO ii=1 TO WORDS(mailist)
  307.       SAY 'Email:' pen3||WORD(mailist,ii)||def||CR
  308.     END
  309.   END
  310. IF ~fromenu & menuflag THEN
  311.   IF getinput(1 1 'Read your private mail now? (nY) > ')='N' THEN RETURN
  312. onename=''
  313. IF menuflag & WORDS(mailist)>3 THEN
  314.   DO
  315.     IF getinput(1 1 'Read all private mail? (nY) > ')='N' THEN
  316.       DO
  317.         onename=getinput(1 0 'Read ONLY private mail from? > ')
  318.         onename=SPACE(STRIP(UPPER(onename)),1,'_')
  319.         onename=COMPRESS(onename,'.,:/*#?^ ')
  320.         IF onename='' THEN RETURN
  321.         IF ~EXISTS(bbspath'Users/'onename) & picklist.1~='BBBBS' THEN
  322.           DO
  323.             SAY '***'pen3 onename def'does not exist!'||CR
  324.             RETURN
  325.           END
  326.       END
  327.   END
  328. DO letter=sl TO WORDS(mailist)
  329.   readname=WORD(mailist,letter)
  330.   uname=readname
  331.   dot=LASTPOS('.',uname)
  332.   IF dot>2 THEN uname=LEFT(uname,dot-1)
  333.   IF onename~='' & onename~=uname THEN ITERATE letter
  334.   arg=bbspath'Email/'name'/'readname        /* user has mail! */
  335.   IF readlines(arg 1) THEN ITERATE letter
  336.   delnum=WORD(lynes.1,2)
  337.   CALL seelines(1)
  338.   nomail=0
  339.   nonstop=0
  340.   mailfile=''
  341.   IF UPPER(WORD(lynes.1,3))='FILE:' THEN mailfile=WORD(lynes.1,4)
  342.   IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' THEN
  343.     DO
  344.       IF LEFT(RIGHT(mailfile,4),1)~='.' & LEFT(readname,6)='BBBBS.' THEN
  345.         DO
  346.           SAY CR
  347.           SAY pen3'The attached file is unarchived and may be incomplete.'CR
  348.           SAY 'If the archiver is still building this file, downloading will fail.'def||CR
  349.           IF getinput(1 1 'Do you want to try to download it anyway? (Ny) > ')~='Y' THEN ITERATE letter
  350.           SAY CR
  351.         END
  352.       curdir=PRAGMA('D')
  353.       CALL setdir(bbspath'EmailFiles/'name)
  354.       filesize=WORD(STATEF(mailfile),2)
  355.       IF menuflag THEN
  356.         IF getinput(1 1 ' Attached file:' pen3||mailfile||def 'is' pen3||filesize||def 'bytes.  Download now? (nY) > ')~='N' THEN
  357.           DO
  358.             mf=bbspath'EmailFiles/'name'/'mailfile
  359.             IF frombb THEN
  360.               DO
  361.                 CALL SETCLIP('BBSMAIL_letter',readname)
  362.                 exitarg=mf
  363.                 SIGNAL DONE
  364.               END
  365.             topath=GETCLIP('BBS_topath')
  366.             IF topath='' THEN topath=GETCLIP('BBS_frompath')
  367.             todir=GetFile(150,36,topath,'',' Destination ',,'NOFILES')
  368.             IF RIGHT(todir,1)='/' THEN todir=LEFT(todir,LENGTH(todir)-1)
  369.             IF WORD(STATEF(todir),1)='DIR' THEN
  370.               DO
  371.                 IF todir~=topath THEN CALL SETCLIP('BBS_topath',todir)
  372.                 SAY 'Copying' mailfile 'to' todir '...'
  373.                 ADDRESS COMMAND 'COPY' mf todir 'CLONE'
  374.               END
  375.             ELSE SAY pen3'*'def||todir||pen3'* is not a valid directory!'def
  376.           END
  377.       menuflag=1
  378.       CALL setdir(curdir)
  379.     END
  380.   IF readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' & LEFT(readname,6)~='BBBBS.' THEN
  381.     DO
  382.       tempchar='A'
  383.       DO WHILE tempchar='A'
  384.         tempchar=getinput(1 1 '['pen3'A'def']gain  ['pen3'C'def']ontinue  ['pen3'R'def']eply (acR) > ')
  385.         IF tempchar='' THEN tempchar='R'
  386.         IF tempchar='A' THEN CALL seelines(1)
  387.       END
  388.       IF tempchar='R' THEN
  389.         DO
  390.           IF WORDS(lynes.4)<2 THEN replysubj='NONE'
  391.           ELSE replysubj=SUBSTR(lynes.4,WORDINDEX(lynes.4,2))
  392.           SAY lm
  393.           IF bbsWrite.rexx(name maxtime-TRUNC(TIME('E')) 'MAIL' uname bbspath'Email/'name'/'readname 0 0 replysubj)~=0 THEN
  394.             emailonline=emailonline+1
  395.           replysubj=''
  396.         END
  397.     END
  398.   IF LEFT(readname,6)~='BBBBS.' & level>0 THEN
  399.     DO
  400.       tempchar='A'
  401.       DO WHILE tempchar='A'
  402.         tempchar=getinput(1 1 'Forward mail from'pen3 uname def'to other users? (aNy) > ')
  403.         IF tempchar='A' THEN CALL seelines(1)
  404.       END
  405.       IF tempchar='Y' THEN
  406.         DO
  407.           IF getfolk(1 pen3'Forward Email To: 'def)=0 THEN
  408.             DO ei=1 TO folk.0 WHILE folk.ei~=''
  409.               CALL MAKEDIR(bbspath'EMail/'folk.ei)
  410.               forwardarg=bbspath'Email/'folk.ei'/'readname
  411.               ADDRESS COMMAND 'C:COPY' bbspath'Email/'name'/'readname forwardarg
  412.               CALL readlines(forwardarg 1)
  413.               lynes.1=lynes.1'  Forwarded to you by' name TIME('C') DATE()
  414.               CALL DELETE(forwardarg)
  415.               CALL savelines(forwardarg)
  416.               IF WORDS(lynes.2)>3 THEN
  417.                 DO
  418.                   forname=bbspath'EmailFiles/'name'/'WORD(lynes.2,4)
  419.                   IF EXISTS(forname) THEN
  420.                     DO
  421.                       CALL MAKEDIR(bbspath'EmailFiles/'folk.ei)
  422.                       ADDRESS COMMAND 'C:COPY' forname bbspath'EmailFiles/'folk.ei
  423.                     END
  424.                 END
  425.               line='Mail' pen3||readname||def 'forwarded to' pen3||folk.ei||def
  426.               emailonline=emailonline+1
  427.               CALL send2log(line)
  428.               SAY line||CR
  429.             END
  430.         END
  431.     END
  432.   tempchar=''
  433.   tempstr='Delete the email ('pen3||delnum||def') from'pen3 uname def'that you just read?'
  434.   IF mailfile='' THEN tempchar=getinput(1 1 tempstr '(nqY) > ')
  435.   ELSE
  436.     DO WHILE tempchar~='N' & tempchar~='Q' & tempchar~='Y'
  437.       tempchar=getinput(1 1 tempstr '(nqy) > ')
  438.     END
  439.   IF tempchar='Q' THEN
  440.     DO
  441.       IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN
  442.         DO
  443.           readname=''
  444.           uname=''
  445.           RETURN
  446.         END
  447.     END
  448.   ELSE IF tempchar~='N' THEN
  449.     DO
  450.       dirname=bbspath'Email/'name'/'
  451.       nodelete=0
  452.       IF bbsprefs.14=1 & name~=sysop & uname~=sysop & WORD(lynes.2,2)~='BBBBS' & WORD(lynes.2,2)~=sysop & WORD(lynes.3,2)~=sysop THEN
  453.         nodelete=1
  454.       IF nodelete THEN
  455.         ADDRESS COMMAND 'C:Copy' dirname||readname bbspath'Email/'sysop
  456.       ELSE emailonline=emailonline-1
  457.       CALL DELETE(dirname||readname)
  458.       tempstr='Old email'
  459.       IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & EXISTS(bbspath'EmailFiles/'name'/'mailfile) THEN
  460.         DO
  461.           IF nodelete THEN
  462.             ADDRESS COMMAND 'C:Copy' bbspath'EmailFiles/'name'/'mailfile bbspath'EmailFiles/'sysop
  463.           CALL DELETE(bbspath'EmailFiles/'name'/'mailfile)
  464.           CALL DELETE(bbspath'EmailFiles/'name'/'mailfile'.xdl')
  465.           tempstr=tempstr 'and attached file'
  466.         END
  467.       tempstr=tempstr 'deleted. Thank you for keeping a clean BBS!'
  468.       SAY tempstr||CR
  469.       IF tempchar='Q' THEN
  470.         IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN
  471.           DO
  472.             readname=''
  473.             uname=''
  474.             RETURN
  475.           END
  476.     END
  477.   ELSE IF LEFT(readname,3)='MSG' & level>sysoplevel THEN
  478.     DO
  479.       ii=LEFT(readname,POS('.',readname)-1)
  480.       ii=SUBSTR(ii,4)%1
  481.       IF getinput(1 1 'Move this message back to the' WORD(lynes.5,8) 'conference? (nY) > 'def)~='N' THEN
  482.         DO
  483.           temp=TRANSLATE(readname,'/','.')
  484.           temp=SUBSTR(temp,4)
  485.           lynes.1='!!'STRIP(lynes.1)
  486.           edtype=''
  487.           CALL savelines(msgpath||temp)
  488.           CALL DELETE(bbspath'Email/'name'/'readname)
  489.         END
  490.     END
  491.   ELSE IF LEFT(readname,3)~='MSG' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' THEN
  492.     DO
  493.       arg=bbspath'Email/'name'/'readname
  494.       CALL readlines(arg 1)
  495.       IF WORDS(lynes.5)<7 THEN
  496.         DO
  497.           lynes.5=lynes.5'  (Rcvd)' DATE('W') DATE() TIME('C')
  498.           CALL DELETE(arg)
  499.           CALL savelines(arg)
  500.           SAY 'Email has been marked as received.'CR
  501.         END
  502.     END
  503.   CALL checktime()
  504.   readname=''
  505.   uname=''
  506.   arg=''
  507. END
  508. IF nomail THEN
  509.   DO
  510.     SAY 'No mail was found.'CR
  511.     CALL waiting()
  512.   END
  513. CALL setdir(libpath||dirs.1)
  514. RETURN
  515.  
  516.  
  517. sortnumbers: PROCEDURE
  518. PARSE ARG slist
  519. IF STRIP(slist)='' THEN RETURN ''
  520. sorted.=''
  521. oldest=999999
  522. newest=0
  523. newlist=''
  524. DO si=1 TO WORDS(slist)
  525.   testword=WORD(slist,si)
  526.   IF ~DATATYPE(testword,'W') THEN
  527.     DO
  528.       testpos=LASTPOS('.',testword)
  529.       IF testpos>0 THEN tempnum=SUBSTR(testword,testpos+1)
  530.       ELSE
  531.         DO
  532.           newlist=testword newlist
  533.           ITERATE si
  534.         END
  535.     END
  536.   ELSE tempnum=testword/1
  537.   IF sorted.tempnum='' THEN
  538.     DO
  539.       sorted.tempnum=testword
  540.       sorted.tempnum.0=1
  541.       IF DATATYPE(tempnum,'W') THEN
  542.         DO
  543.           IF tempnum>newest THEN newest=tempnum
  544.           IF tempnum<oldest THEN oldest=tempnum
  545.         END
  546.     END
  547.   ELSE newlist=newlist testword
  548. END
  549. IF oldest~=999999 & newest~=0 THEN
  550.   DO si=oldest TO newest
  551.     IF sorted.si.0=1 THEN newlist=newlist sorted.si
  552.   END
  553. RETURN STRIP(newlist)
  554.  
  555.  
  556. readopen:
  557. PARSE ARG fname
  558. ok=OPEN(f,fname,'R')
  559. IF ok~=0 THEN RETURN 1
  560. line=fname 'failed to open for reading!'
  561. SAY line||CR
  562. RETURN 0
  563.  
  564.  
  565. seelines:
  566. DO i=1 TO lynes.0
  567.   SAY lynes.i||def||CR
  568.   IF i//linesperpage=0 THEN
  569.     IF waiting2() THEN LEAVE i
  570. END
  571. nonstop=0
  572. RETURN
  573.  
  574.  
  575. readlines:
  576. CALL CLOSE(f)
  577. PARSE ARG tempname readstart .
  578. IF ~readopen(tempname) THEN RETURN 1
  579. IF readstart<2 THEN lynes.=''
  580. DO ri=readstart
  581.   line=READLN(f)
  582.   IF EOF(f) THEN BREAK
  583.   lynes.ri=line
  584. END
  585. lynes.0=ri-1
  586. CALL CLOSE(f)
  587. DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),1)='/'
  588. END
  589. lynes.0=ri
  590. RETURN 0
  591.  
  592.  
  593. savelines:
  594. PARSE ARG tempname .
  595. ok=OPEN(f,tempname,'W')
  596. IF ok=0 THEN
  597.   DO
  598.     SAY '***' tempname 'failed to open for saving!'CR
  599.     RETURN 1
  600.   END
  601. DO wi=1 TO lynes.0
  602.   CALL WRITELN(f,lynes.wi)
  603. END
  604. CALL CLOSE(f)
  605. RETURN 0
  606.  
  607.  
  608. getfolk:
  609. PARSE ARG startnum selectline
  610. SAY 'Enter a list of comma separated user names'CR
  611. folk.startnum=getinput(1 0 selectline' ')
  612. IF STRIP(folk.startnum)='' THEN RETURN 1
  613. folk.startnum=SPACE(folk.startnum,1,'_')
  614. folk.0=startnum
  615. IF POS(',',folk.startnum)>0 THEN
  616.   DO
  617.     temp=TRANSLATE(folk.startnum,' ',',')
  618.     folk.0=folk.0+WORDS(temp)
  619.     DO ei=startnum TO startnum+WORDS(temp)
  620.       folk.ei=STRIP(WORD(temp,ei))
  621.       IF LEFT(folk.ei,1)='_' THEN
  622.         folk.ei=SUBSTR(folk.ei,2)
  623.     END
  624.   END
  625. DO ei=1 TO folk.0
  626.   folk.ei=check_alias(folk.ei)
  627.   DO WHILE ~EXISTS(bbspath'Users/'folk.ei)
  628.     SAY folk.ei 'not found! Enter that name again or press RETURN.'CR
  629.     folk.ei=getinput(1 0 pen3||selectline' 'def)
  630.     folk.ei=cleanstring(folk.ei)
  631.   END
  632. END
  633. RETURN 0
  634.  
  635.  
  636. pickfromlist:
  637. DO pfl=1 TO picklist.0 BY 3
  638.   pfl2=pfl+1
  639.   pfl3=pfl+2
  640.   pfline=pen3||RIGHT(pfl,3)||def LEFT(picklist.pfl,21)
  641.   IF picklist.pfl2~='' THEN
  642.     pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(picklist.pfl2,21)
  643.   IF picklist.pfl3~='' THEN
  644.     pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(picklist.pfl3,21)
  645.   SAY pfline||CR
  646. END
  647. emnum=getinput(1 0 pen3'Select Email Number > 'def)
  648. IF ~DATATYPE(emnum,'W') | emnum<1 | emnum>picklist.0 THEN RETURN 0
  649. RETURN emnum
  650.  
  651.  
  652. cleanline:
  653. ARG lflag .
  654. IF nonstop=0 & clr~='' & frombb THEN
  655.   DO
  656.     Send clr
  657.     RETURN
  658.   END
  659. cline=lineup||LEFT(' ',78)
  660. IF lflag=1 THEN cline=cline||lineup
  661. SAY cline||CR
  662. RETURN
  663.  
  664.  
  665. cleanstring:
  666. PARSE ARG cstr
  667. cstr=TRANSLATE(cstr,,namemask)
  668. cstr=SPACE(cstr,1,'_')
  669. RETURN cstr
  670.  
  671.  
  672. setdir:
  673. PARSE ARG tempdir
  674. CALL PRAGMA('D',STRIP(tempdir))
  675. directory=PRAGMA('D')
  676. IF frombb THEN Data directory
  677. slash=LASTPOS('/',directory)
  678. IF slash=0 THEN slash=LASTPOS(':',directory)
  679. plaindir=directory
  680. IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
  681. RETURN
  682.  
  683.  
  684. check_alias:
  685. ARG ali .
  686. IF ~DATATYPE(Friends.0,'W') THEN RETURN ali
  687. DO ii=1 TO Friends.0
  688.   IF UPPER(WORD(Friends.ii,1))=ali THEN RETURN WORD(Friends.ii,2)
  689. END
  690. RETURN ali
  691.  
  692.  
  693. showtext:
  694. PARSE ARG arg .
  695. IF EXISTS(arg) THEN
  696.   DO
  697.     IF readlines(arg 1) THEN RETURN
  698.     CALL seelines(1)
  699.     nonstop=0
  700.     CALL waiting()
  701.   END
  702. RETURN
  703.  
  704.  
  705. busywait:
  706. ARG bii bi bt 
  707. IF bii>4 & bi//(10*bii)=0 THEN CALL checkdcd()
  708. IF bbsprefs.21=0 THEN RETURN
  709. IF bi<1 THEN
  710.   DO
  711.     CALL WRITECH(STDOUT,'080808'x)
  712.     IF ni<1 & i>999998 & wi>999998 THEN SAY CR
  713.     RETURN
  714.   END
  715. IF bi=1 THEN CALL WRITECH(STDOUT,'   ')
  716. IF bi//(bii%2)~=0 THEN RETURN
  717. b=bi//bii
  718. IF b=0 | b=bii%2 THEN
  719.   DO
  720.     tp=RIGHT((bi*100)%bt,2)'%'
  721.     CALL WRITECH(STDOUT,'080808'x||tp)
  722.   END
  723. RETURN
  724.  
  725.  
  726. postuser:
  727. IF ~frombb | ~SHOW('P','BBSPOST') THEN RETURN
  728. PARSE ARG parg 
  729. ptext=GETCLIP('BBSPOST4')
  730. IF WORDS(ptext)>4 THEN ptext=LEFT(ptext,WORDINDEX(ptext,5)-1)
  731. ptext=STRIP(ptext)
  732. ptext=CENTER(ptext'   EMail:' parg,74)
  733. CALL SETCLIP('BBSPOST4',ptext)
  734. ADDRESS BBSPOST 'UPDATE'
  735. RETURN
  736.  
  737.  
  738. waiting:
  739. CALL checktime()
  740. IF waitchar='Q' THEN
  741.   DO
  742.     waitchar=''
  743.     RETURN
  744.   END
  745. waitchar=''
  746. IF nonstop=1 THEN RETURN
  747. OPTIONS PROMPT pen3'                       RETURN=Continue  'def
  748. PULL waitchar
  749. CALL cleanline(1)
  750. RETURN
  751.  
  752.  
  753. waiting2:
  754. CALL checktime()
  755. IF nonstop=1 THEN RETURN 0
  756. waitchar=getinput(1 1 pen3'   Q=Quit   N=Non-Stop   RETURN=Continue  'def)
  757. IF waitchar='N' THEN
  758.   DO
  759.     nonstop=1
  760.     SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E        'def||CR
  761.     SAY CR
  762.     CALL DELAY(100)
  763.     waitchar=''
  764.   END
  765. CALL cleanline(1)
  766. IF waitchar='Q' THEN RETURN 1
  767. RETURN 0
  768.  
  769.  
  770. getinput:
  771. PARSE ARG upflag' 'oneflag' 'pline
  772. CALL checktime()
  773. OPTIONS PROMPT pline
  774. PARSE PULL inarg
  775. inarg=STRIP(inarg)
  776. IF upflag THEN inarg=UPPER(inarg)
  777. IF oneflag THEN inarg=LEFT(inarg,1)
  778. RETURN inarg
  779.  
  780.  
  781. checktime:
  782. IF ~frombb THEN RETURN
  783. IF TIME('E')>maxtime THEN EXIT 0
  784. IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
  785. MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
  786. CALL checkdcd()
  787. RETURN
  788.  
  789.  
  790. checkdcd:
  791. IF ~frombb THEN RETURN
  792. dcd
  793. IF RC=0 THEN
  794.   DO
  795.     DO dcds=1 TO 3  /* 5 second delay */
  796.       CALL DELAY(50)
  797.       dcd
  798.       IF RC~=0 THEN RETURN
  799.     END
  800.     dcd
  801.     IF RC=0 THEN EXIT 0
  802.   END
  803. xmsg=GETCLIP('BBS_MESSAGE')
  804. IF xmsg~='' THEN
  805.   DO
  806.     SAY CR
  807.     SAY bak2' Message From BBBBS: 'def||CR
  808.     SAY xmsg||CR
  809.     SAY CR
  810.     CALL SETCLIP('BBS_MESSAGE')
  811.     CALL waiting()
  812.   END
  813. IF POS('G',GETCLIP('BBS_COMMAND'))>0 THEN EXIT
  814. RETURN
  815.  
  816.  
  817. config:
  818. arg='s:CONFIG.BBS'
  819. IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
  820. IF readlines(arg 1) THEN
  821.   DO
  822.     SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'CR
  823.     EXIT 1
  824.   END
  825. compos=POS('/*',lynes.1)
  826. IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
  827. bbsname=STRIP(lynes.1)
  828. CALL SETCLIP('BBS_bbsname',bbsname)
  829. sysop=WORD(lynes.2,1)
  830. compos=POS('/*',lynes.3)
  831. IF compos>0 THEN lynes.3=LEFT(lynes.3,compos-1)
  832. exclusion=STRIP(lynes.3)
  833. bbsdevice=WORD(lynes.4,1)
  834. sysoplevel=WORD(lynes.5,1)
  835. bbspath=WORD(lynes.6,1)
  836. IF ~EXISTS(bbspath) THEN
  837.   DO
  838.     SAY bbspath 'does not exist!'CR
  839.     EXIT 1
  840.   END
  841. testchar=RIGHT(bbspath,1)
  842. IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
  843. msgpath=WORD(lynes.7,1)
  844. IF ~EXISTS(msgpath) THEN
  845.   DO
  846.     SAY msgpath 'does not exist!'CR
  847.     EXIT 1
  848.   END
  849. testchar=RIGHT(msgpath,1)
  850. IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
  851. msgpath=msgpath'MSG'
  852. DO i=16 TO 41
  853.   j=i-15
  854.   bbsprefs.j=STRIP(WORD(lynes.i,1))
  855. END
  856. IF bbsprefs.10 THEN scratch=bbspath'Scratch'
  857. ELSE scratch='RAM:Scratch'
  858. CALL MAKEDIR(scratch)
  859. IF ~DATATYPE(bbsprefs.16,'W') THEN bbsprefs.16=3
  860. RETURN
  861.  
  862.  
  863. send2log:
  864. PARSE ARG sendline
  865. IF ~frombb THEN RETURN
  866. logfile=bbspath'Logs/log.'DATE('S')
  867. fl='W'
  868. IF EXISTS(logfile) THEN fl='A'
  869. IF ~OPEN('log',logfile,fl) THEN
  870.   DO
  871.     IF ~OPEN('log',logfile,fl) THEN
  872.       DO
  873.         SAY 'failed to open log file'
  874.         RETURN
  875.      END
  876.   END
  877. CALL WRITELN('log','bbsMail:' sendline)
  878. CALL CLOSE('log')
  879. RETURN
  880.  
  881.  
  882. BREAK_E:
  883. i=999999
  884. ri=999999
  885. wi=999999
  886. RETURN
  887.  
  888.  
  889. BREAK_C:
  890. EXIT 1
  891.  
  892.  
  893. FAILURE:
  894. SYNTAX:
  895. lin.1=''ERRORTEXT(RC)''
  896. lin.2=SIGL-1     SOURCELINE(SIGL-1)
  897. lin.3=SIGL ''SOURCELINE(SIGL)''
  898. lin.4=SIGL+1     SOURCELINE(SIGL+1)
  899. DO er=1 TO 4
  900.   IF level>sysoplevel | ~frombb THEN SAY 'bbsMail:' lin.er||CR
  901.   IF frombb THEN CALL send2log(lin.er)
  902. END
  903. EXIT 1
  904.  
  905. /* bbsMail.rexx */
  906.